4  Socialna omrežja in podnapisi

Primer preprostega animiranega zemljevida, ki prikazuje časovni potek čivkov o smrti bobnarja rockovske skupine Rolling Stones, Charlieja Wattsa. Zajeti so bili čivki v devetdnevnem obdobju v angleščini, nemščini in slovenščini. Petrič 2022

Show the code

knitr::include_graphics("pictures/rolling_stones_tweets_animated.gif")

4.1 Nalaganje knjižnic

Show the code

library(tidyverse)
library(tidytext)
library(readxl)
library(writexl)
library(quanteda)
library(quanteda.textstats)
library(quanteda.textplots)
library(rtweet)
library(Twitmo)
library(ndjson)
library(plotly)
library(lubridate)
library(igraph)
library(textfeatures)
library(ggwordcloud)

4.2 Poizvedbe v omrežju Twitter

4.2.1 Preverjanje pristnosti (avtentikacija)

Za poizvedbe se morate najprej prijaviti na Twitterjevem programskem vmesniku (API).

Za poizvedbe je treba ustvariti Twitter App <apps.twitter.com>. Opis: gl. https://mkearney.github.io/nicar_tworkshop/#10.

Najpreprostejša prijava z lastno Twitterjevo aplikacijo poteka z naslednjim ukazom:

Show the code

rtweet::auth_setup_default()

R pošilja vaš čivk.

Show the code

post_tweet(paste0("My first tweet with #rtweet #rstats at ", Sys.time()))

Nekaj koristnih naslovov s “kuharskimi” recepti za poizvedovanje v socialnem omrežju Twitter:

https://cran.r-project.org/web/packages/rtweet/vignettes/rtweet.html

https://mkearney.github.io/nicar_tworkshop/#1

https://www.gbailey.uk/twitter_workshop/pt2_collection.html

https://rpubs.com/vivvi87/rtweet_notes

https://predictivehacks.com/how-to-get-twitter-data-using-r/

4.2.2 Sprotne poizvedbe

4.2.2.1 Prijatelji

Pridobi id prijateljev navedene osebe s funkcijo get_friends() knjižnice rtweet, tj. katerim uporabnikom navedena oseba sledi.

Show the code

prijatelji_jj <- get_friends("jjansasds")
prijatelji_al <- get_friends("anzelog")

saveRDS(prijatelji_jj, "data/twitter/politiki/prijatelji_jansa.rds")
saveRDS(prijatelji_al, "data/twitter/politiki/prijatelji_logar.rds")

Odpiramo shranjeno poizvedbo.

Show the code

prijatelji_jj <- read_rds("data/twitter/politiki/prijatelji_jansa.rds")
prijatelji_al <- read_rds("data/twitter/politiki/prijatelji_logar.rds")

dim(prijatelji_jj)

[1] 4080    2

Show the code

dim(prijatelji_al)

[1] 959   2

Janez Janša sledi 4060 uporabnikom, Anže Logar pa 959 uporabnikom.

Kateri prijatelji so skupni oz. katerim uporabnikom sledita oba politika? To lahko hitro ugotovimo s funkcijo intersect().

Show the code

prijatelji_skupni <- 
  intersect(prijatelji_jj$to_id, prijatelji_al$to_id) %>% 
  as_tibble_col(column_name = "skupni_prijatelji")
dim(prijatelji_skupni)

[1] 557   1

Mnogim uporabnikom, ki jim sledi Anže Logar (tj. 557 od 959), sledi tudi Janez Janša.

Kateri so ti skupni prijatelji? To lahko ugotovimo s funkcijo lookup_users().

Show the code

prijatelji_jj_data <- lookup_users(prijatelji_jj$to_id)
prijatelji_al_data <- lookup_users(prijatelji_al$to_id)

saveRDS(prijatelji_jj_data, "data/twitter/politiki/prijatelji_jansa_data.rds")
saveRDS(prijatelji_al_data, "data/twitter/politiki/prijatelji_logar_data.rds")

Odpiramo shranjeno poizvedbo.

Show the code

prijatelji_jj_data <- read_rds("data/twitter/politiki/prijatelji_jansa_data.rds")
prijatelji_al_data <- read_rds("data/twitter/politiki/prijatelji_logar_data.rds")

dim(prijatelji_jj_data)

[1] 4079   23

Show the code

dim(prijatelji_al_data)

[1] 959  23

Show the code

prijatelji_skupni_data <- 
  intersect(prijatelji_jj_data$name, prijatelji_al_data$name) %>% 
  as_tibble_col(column_name = "imena_skupnih_prijateljev")
dim(prijatelji_skupni_data)

[1] 562   1

Poizvedba nam je dala 562 skupnih prijateljev. Tu so imena:

Show the code

prijatelji_skupni_data %>% 
  rmarkdown::paged_table()

Skupni prijatelji so lahko npr. povezani z izbiro pogovorne tematike, značilnih izrazov itd.

4.2.2.2 Sledilci

Ukaz get_followers() nam omogoča najti sledilce navedenega uporabnika.

Show the code

npmusar_sledilci <- get_followers("nmusar", 
                                  retryonratelimit = TRUE)
npmusar_sledilci_data <- lookup_users(npmusar_sledilci$from_id)

saveRDS(npmusar_sledilci, "data/twitter/politiki/npmusar_sledilci.rds")
saveRDS(npmusar_sledilci_data, "data/twitter/politiki/npmusar_sledilci_data.rds")

Odpiramo shranjeno poizvedbo.

Show the code

npmusar_sledilci_data <- read_rds("data/twitter/politiki/npmusar_sledilci_data.rds")

dim(npmusar_sledilci_data)

[1] 5000   23

Show the code

npmusar_sledilci_data %>% rmarkdown::paged_table()

Show the code

npmusar_sledilci_data %>% 
  filter(str_detect(name, "Janša")) %>% 
  rmarkdown::paged_table()

4.2.2.3 Iskanje čivkov

Funkcija search_tweets() nam vrne tabelo čivkov z ozirom na tematsko vprašanje.

Show the code

q <- "ukrajina"

ukraijina <- search_tweets(q = q, 
                        n = 1000,
                        # token = rtweet_app(bearer_token$access_token),
                        include_rts = FALSE,
                        `-filter` = "replies",
                        lang = "sl"
                        )

saveRDS(ukraijina,
        "data/twitter/politiki/ukraijina_tweets_sl.rds")

Odpiramo shranjeno poizvedbo.

Show the code

ukraijina <- read_rds(
  "data/twitter/politiki/ukraijina_tweets_sl.rds")

dim(ukraijina)

[1] 101  43

4.2.2.4 Časovnica

Privzeto 100 čivkov, zgornja meja n = 3200. Še več, če pridobil bearer_token.

Show the code

fajon_timeline <- get_timeline("tfajon", n = 3200)

saveRDS(fajon_timeline, "data/twitter/politiki/fajon_timeline.rds")

Odpiramo shranjeno poizvedbo.

Show the code

fajon_timeline <-
  read_rds("data/twitter/politiki/fajon_timeline.rds")

Show the code

tline_plot_fajon <- fajon_timeline |> 
  filter(created_at > "2022-01-01") |> 
  ts_plot(by = "weeks", trim = 1L, color = "magenta") +
  geom_point() +
  theme_minimal() +
  theme(
    legend.title = element_blank(),
    legend.position = "bottom",
    plot.title = element_text(face = "bold")) +
  labs(
    x = NULL, y = NULL,
    title = "Frequency of Twitter statuses by Tanja Fajon",
    subtitle = "Twitter status counts aggregated by weeks from 2022",
    caption = "Source: Data collected from Twitter's REST API via rtweet"
  )

library(plotly)
ggplotly(tline_plot_fajon)

4.2.2.5 Priljubljeni čivki

Pridobiti želimo 10 zadnjih priljubljenih čikov Tanje Fajon in Mateja Tonina.

Show the code

favorit_fajon <- get_favorites("tfajon", n = 10)
favorit_tonin <- get_favorites("MatejTonin", n = 10)

saveRDS(favorit_fajon, "data/twitter/politiki/fajon_favorit.rds")
saveRDS(favorit_tonin, "data/twitter/politiki/tonin_favorit.rds")

Odpiramo shranjeno poizvedbo.

Show the code

favorit_fajon <-
  read_rds("data/twitter/politiki/fajon_favorit.rds")
favorit_tonin <-
  read_rds("data/twitter/politiki/tonin_favorit.rds")

Show the code

favorit_fajon %>% 
  select("text", "created_at", "id_str") %>%
  rmarkdown::paged_table()

Show the code

favorit_tonin %>% 
  select("text", "created_at", "id_str") %>%
  rmarkdown::paged_table()

4.2.2.6 Poglej izbrane čivke

Kontroverzni čivki Donalda Trumpa.

Show the code

## status IDs
status_ids <- c("947235015343202304", "947592785519173637", 
  "948359545767841792", "832945737625387008")
## lookup tweets
twt <- lookup_tweets(status_ids)

Kontroverzni čivki Janeza Janša.

Jansa’s tweet, Carpenter’s reaction and Fazlic commenting on Carpenter’s reaction

Show the code

# status_id = "1319567043218296833" (Jansa's suport from Trump)
status = "1320064582170398722" # Comment on Carpenter's tweet by Damir Fazlić
tw1 <- lookup_statuses(status)
tw1

# A tibble: 1 × 43
  created_at               id id_str full_…¹ trunc…² displ…³ entities     source
  <dttm>                <dbl> <chr>  <chr>   <lgl>     <dbl> <list>       <chr> 
1 2020-10-24 20:08:16 1.32e18 13200… "Micha… FALSE       263 <named list> "<a h…
# … with 35 more variables: in_reply_to_status_id <lgl>,
#   in_reply_to_status_id_str <lgl>, in_reply_to_user_id <lgl>,
#   in_reply_to_user_id_str <lgl>, in_reply_to_screen_name <lgl>, geo <list>,
#   coordinates <list>, place <list>, contributors <lgl>,
#   is_quote_status <lgl>, quoted_status_id <dbl>, quoted_status_id_str <chr>,
#   quoted_status_permalink <list>, retweet_count <int>, favorite_count <int>,
#   favorited <lgl>, retweeted <lgl>, possibly_sensitive <lgl>, lang <chr>, …

Janša’s provocative tweet

Show the code

# status_id = "1319567043218296833" (Jansa's suport for Trump)
status = "1319567043218296833"
tw <- lookup_statuses(status)
tw

# A tibble: 1 × 43
  created_at               id id_str full_…¹ trunc…² displ…³ entities     source
  <dttm>                <dbl> <chr>  <chr>   <lgl>     <dbl> <list>       <chr> 
1 2020-10-23 11:11:14 1.32e18 13195… "We re… FALSE       279 <named list> "<a h…
# … with 35 more variables: in_reply_to_status_id <lgl>,
#   in_reply_to_status_id_str <lgl>, in_reply_to_user_id <lgl>,
#   in_reply_to_user_id_str <lgl>, in_reply_to_screen_name <lgl>, geo <list>,
#   coordinates <list>, place <list>, contributors <lgl>,
#   is_quote_status <lgl>, retweet_count <int>, favorite_count <int>,
#   favorited <lgl>, retweeted <lgl>, lang <chr>, possibly_sensitive <list>,
#   quoted_status <list>, text <chr>, favorited_by <lgl>, scopes <lgl>, …

Show the code

# status_id = "1324075189802512384" (Jansa: lefties can't stand Trump is winner)
# status_id = "1323913419200864256" (Jansa: Trump is winner)
status2 = "1323913419200864256"
tw2 <- lookup_statuses(status2)
tw2

# A tibble: 1 × 43
  created_at               id id_str full_…¹ trunc…² displ…³ entities     source
  <dttm>                <dbl> <chr>  <chr>   <lgl>     <dbl> <list>       <chr> 
1 2020-11-04 10:02:10 1.32e18 13239… It’s p… FALSE       253 <named list> "<a h…
# … with 35 more variables: in_reply_to_status_id <lgl>,
#   in_reply_to_status_id_str <lgl>, in_reply_to_user_id <lgl>,
#   in_reply_to_user_id_str <lgl>, in_reply_to_screen_name <lgl>, geo <list>,
#   coordinates <list>, place <list>, contributors <lgl>,
#   is_quote_status <lgl>, retweet_count <int>, favorite_count <int>,
#   favorited <lgl>, retweeted <lgl>, possibly_sensitive <lgl>, lang <chr>,
#   quoted_status <list>, text <chr>, favorited_by <lgl>, scopes <lgl>, …

Poizvedba s 5. novembra 2020.

Show the code

# status_id = "1323913419200864256" (Jansa's claim that Trump is winner of elections)
tweets_replies_jj_support2 <- search_tweets(q = "1323913419200864256", 
                        n = 18000,
                        include_rts = FALSE,
                        `-filter` = "replies",
                        lang = "en")

Shranjena poizvedba s 5. novembra 2020.

Show the code

tweets_replies_jj_support2 <- read_rds("data/twitter/politiki/replies_to_jj_support_for_trump.rds")

tweets_replies_jj_support2 %>% 
  select(text, created_at, name, screen_name) %>% 
  rmarkdown::paged_table()

4.2.2.7 Streaming – Tok v živo

Show the code

library(Twitmo)
library(ndjson)

## random sample
nakljucen_tok <- get_tweets(method = 'stream', 
           location = "SLV", 
           timeout = 30, 
           file_name = "data/slv_tweet_stream.json")

Show the code

nakljucen_tok <- ndjson::stream_in("data/slv_tweet_stream.json")

nakljucen_tok[1:10] %>% 
  select(text)

                                                                                                            text
 1:                                                                                    @german_erazo Sa mierddd.
 2:     Responde de inmediato #MAR para el 1-1 en 9 minutos.\n\n¿Nos espera un gran partido por el tercer lugar?
 3:                                                                                               Khaaaaaaaaaa 😳
 4:                                                                               @valentgarzonc Que mujerón !!!
 5:                                                          Borracho pero responsable 🙂 https://t.co/IHI3Os5qQ2
 6:                                                                                            Dale Marruecos 🇲🇦
 7:                                                                                     @PetterOficial13 Gifcard
 8:                                                             Golazo de Croacia, empató Marruecos 🤣 #Qatar2022
 9:                                                                                               A bueno... 1-1
10: @conservcorner1 @micheleconunaL @WalmartMXyCAM Pues yo no entro a un lugar donde me exijan mascarilla. Punto

Show the code

st <- stream_tweets(q = "Soccer World Cup", timeout = 30,
                    file_name = "data/stream_tweets32907e436248.json")

Show the code

st <- ndjson::stream_in("data/stream_tweets32907e436248.json")

st %>% 
  slice_sample(n = 10) %>% 
  select(text)

                                                                                                                                                text
 1:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/ROtDmoKmzd
 2:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/0taaWJfyVd
 3: RT @waynojam: 🔴𝐆𝐨 𝐎𝐧 𝐋𝐢𝐯𝐞📺@foxsportsfreetv\n\nWatch 2022 FIFA World Cup Football/Soccer Third-Place Play-off Game Live Streams Online Free\n\n🔴…
 4:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/t5HoH7BMwV
 5:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/Wy6FfA5PLk
 6: RT @waynojam: 🔴𝐆𝐨 𝐎𝐧 𝐋𝐢𝐯𝐞📺@foxsportsfreetv\n\nWatch 2022 FIFA World Cup Football/Soccer Third-Place Play-off Game Live Streams Online Free\n\n🔴…
 7:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/yDIaCs9gwc
 8:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/tLkCVIRzdo
 9:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/aU3F9thVNw
10:                            Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/X5Bm9izpf7

Show the code

iran <- stream_tweets(q = "Iran", timeout = 30, 
                    file_name = "data/iran.json")

Show the code

iran <- ndjson::stream_in("data/iran.json")

iran %>% 
  slice_sample(n = 10) %>% 
  select(text)

                                                                                                                                             text
 1:  RT @G_Dallemagne: Je suis le parrain politique de l’étudiante MAHSA MOHAMMADI. Enlevée par des milices de la rép. islamique d’Iran il y a 6…
 2:  RT @NatalieAmiri: Die Islamische Republik braucht keine Sittenpolizei. Sie haben noch viele noch viel schlimmere Schergen, die den Frauen d…
 3: 🔴Llamamiento de @ispsoe para detener la ejecución del futbolista iraní Amir Nasr-Azadani\n👉🏽Instan a todos los gobie… https://t.co/JgrMffqEgC
 4:                                                           RT @fasc1nate: A stunning color pencil shop in Tehran, Iran https://t.co/NGwZsa9PTc
 5:   از حمایت بشردوستان جهان بخصوص آقای  @JamesCleverly از #انقلاب۱۴۰۱ سپاسگزاریم.\n\n#مهسا_امینی\n#StopExecutionInIran… https://t.co/1PI6gyHjBf
 6: RT @Irandokht_60: @elonmusk Elon please throw Islamic regime's leaders out of Twitter.\nThey have filtered Twitter in Iran, to kill Iranians…
 7:  RT @fargosi: El Gobierno, la Cancillería, la Secretaría de DDHH y el colectivo verde, no condenan la ejecución de un jugador iraní por apoy…
 8: RT @Taheri_Movement: Der Präsident der Ärztekammer Hamburg Dr. med. @emami_p\n übernimmt eine Patenschaft für den im Iran zum Tode verurteil…
 9:  RT @G_Dallemagne: Je suis le parrain politique de l’étudiante MAHSA MOHAMMADI. Enlevée par des milices de la rép. islamique d’Iran il y a 6…
10:                                     RT @EndGameWW3: Iran's Nuclear Chief Says Uranium Enrichment 'More Than Doubled'\nhttps://t.co/qS0Qc2FigF

Druge rtweet funkcije:

search_users()
lookup_users()
get_trends()
stream_tweets()
lists_members()
lists_statuses()

lookup_coords()
tweet_shot()
post_*()
ts_data()
lat_lng()
emojis
stopwordslangs

4.2.2.8 Analiza omrežja

Analiza in upodobitev omrežij s knjižnico igraph:
https://kateto.net/netscix2016.html

Show the code

## get friends of multiple accounts
fds <- get_friends(c("nmusar", "anzelog", "tfajon"), 
                   retryonratelimit = TRUE)

## frequency count of accounts followed by the users queried above
tbl <- table(fds$from_id)

## subset fds data to only those followed by 5 or more
fds3 <- subset(fds, from_id %in% names(tbl[tbl > 15L]))

fds3_names <- lookup_users(fds3$to_id)
fds3_names <- fds3_names %>% 
  rename(to_id = id_str)
fds3_names <- fds3_names %>% 
  select(to_id, name)

fds3 <- fds3 %>% left_join(fds3_names, by = "to_id")
fds3 <- fds3 %>% select(1,3,2)

## convert fds3 to matrix
mat <- as.matrix(fds3)
saveRDS(mat, "data/mat.rds")

fds3 <- fds3 %>% select(1,2)
## convert fds3 to matrix
mat <- as.matrix(fds3)
saveRDS(mat, "data/mat.rds")

## convert to graph object
mat <- igraph::graph_from_edgelist(mat, directed = TRUE)
saveRDS(mat, "data/mat_igraph.rds")

Show the code

mat <- read_rds("data/mat_igraph.rds")

Show the code

mat

IGRAPH c75d01a DN-- 4454 5865 -- 
+ attr: name (v/c)
+ edges from c75d01a (vertex names):
 [1] nmusar->Dejan 🧬✍️ 📷 🏃🇸🇮       nmusar->Dejan 🧬✍️ 📷 🏃🇸🇮      
 [3] nmusar->Emmanuel Macron      nmusar->Emmanuel Macron     
 [5] nmusar->Emmanuel Macron      nmusar->President of Ireland
 [7] nmusar->Klaus Iohannis       nmusar->President of Malta  
 [9] nmusar->Katrín Jakobsdóttir  nmusar->Vesna Pusić         
[11] nmusar->Vesna Pusić          nmusar->Bajram Begaj        
[13] nmusar->Buitengebieden       nmusar->Ingrida Šimonytė    
[15] nmusar->Albin Kurti          nmusar->Albin Kurti         
+ ... omitted several edges

Show the code

# head(mat)
# mat[]

Show the code

V(mat)$name[1:5]

[1] "nmusar"               "Dejan 🧬✍️ 📷 🏃🇸🇮"    "Emmanuel Macron"     
[4] "President of Ireland" "Klaus Iohannis"      

Show the code

## plot network
# plot(mat)

plot(mat, layout = layout_nicely(mat), 
     edge.arrow.size=.25, vertex.color="gold", vertex.size=5, 
     vertex.frame.color="gray", # vertex.shape = "none", 
     vertex.label.color=c("pink","skyblue"), edge.curved=0.2, 
     vertex.label.cex=0.3, vertex.label.dist=5)

Show the code

mats <- simplify_and_colorize(mat)
mats <- delete_edges(mats, which(E(mats)$weight <= 0.1)) # condition
mats <- delete_vertices(mats, which(degree(mats) <= 1)) # condition
plot(mats, layout = layout_nicely(mats), vertex.size=5)

Show the code

mats <- simplify(mat, remove.multiple = T, 
                              remove.loops = F, 
                              edge.attr.comb=c(weight="sum", 
                                               type="ignore"))
mats <- delete_edges(mats, which(E(mats)$weight <= 0.1)) # condition
mats <- delete_vertices(mats, which(degree(mats) <= 1)) # condition
plot(mats, vertex.label.dist=1.5, vertex.label = NA)

Pretvori povezave (edge) in vozlišča (vertex) v tabele (dataframe).

Show the code

as_data_frame(mat, what="edges") %>% rmarkdown::paged_table()

Show the code

as_data_frame(mat, what="vertices") %>% rmarkdown::paged_table()

4.2.2.9 Sentimentna analiza

---

4.2.3 Že opravljene poizvedbe

4.2.3.1 Časovnice

Časovnice slovenskih politikov na Twitterju.

Show the code

seznam_polit <- list.files(path = "data/twitter/politiki/",
                           pattern = "_2022-12-16.rds",
                           full.names = TRUE)

seznam_imen <- str_replace(
  seznam_polit, 
  pattern = "(^.*politiki/)(.*)(_time.*.rds$)",
  replacement = "\\2")

politiki_df <- NULL

for(i in 1:length(seznam_polit)){
  x <- read_rds(seznam_polit[i]) %>% 
    mutate(author = seznam_imen[i])
  politiki_df <- bind_rows(politiki_df, x)
}

write_xlsx(politiki_df, 
           "data/twitter/politiki/twitter_politiki_df.xlsx")

dim(politiki_df)

[1] 23829    44

Show the code

politiki_df %>%
  group_by(created_at, author) %>% 
  count(author, sort = TRUE) %>% 
  ungroup() %>% 
  group_by(author) %>% 
  filter(created_at > "2018-01-01") %>%
  ts_plot("weeks", color = "blue") +
  labs(x = "", y = "") +
  facet_wrap(~ author, scales = "free_y")

Show the code

p1 <- politiki_df %>% 
  filter(created_at > "2018-01-01") %>%
  group_by(author) %>% 
  ts_plot("days", color = "red") +
  theme_minimal() +
  theme(plot.title = ggplot2::element_text(face = "bold")) +
  labs(
    x = NULL, y = NULL,
    title = "Frequency of Twitter statuses",
    subtitle = "Twitter status (tweet) counts aggregated using week intervals",
    caption = "\nSource: Data collected from Twitter's REST API via rtweet"
  ) +
  facet_wrap(~ author, scales = "free_y")

library(plotly)
ggplotly(p1)

4.2.3.2 Jeziki

Preštej jezike:

Show the code

politiki_df %>% 
  count(lang, sort = TRUE)

# A tibble: 41 × 2
   lang      n
   <chr> <int>
 1 sl    19176
 2 en     2727
 3 und     950
 4 cs      147
 5 zxx     137
 6 qme     121
 7 es       79
 8 pl       60
 9 fr       42
10 in       42
# … with 31 more rows

Izberi samo čivke v slovenščini:

Show the code

politiki_df <- politiki_df %>% 
  filter(lang == "sl")
dim(politiki_df)

[1] 19176    44

4.2.3.3 Vsota besed (tokens)

Vsota besed (tokens), najdaljši in najkrajši čivki.

Show the code

politiki_tokens_sum <- politiki_df %>% 
  group_by(author) %>% 
  summarise(tokens_sum = sum(ntoken(text)), 
            tokens_min = min(ntoken(text)),
            tokens_max = max(ntoken(text)),
            char_max = max(nchar(text))) %>% 
  arrange(-tokens_sum)

politiki_tokens_sum %>% rmarkdown::paged_table()

4.2.3.4 Povprečna dolžina čivka

Koliko besed (z ločili in simboli vred) čivkajo politiki v povprečju?

Show the code

politiki_token_mean <- politiki_df %>% 
  group_by(author) %>% 
  summarise(median_token = median(ntoken(text)), 
            mean_token = mean(ntoken(text)),
            sd_token = sd(ntoken(text))) %>% 
  arrange(-mean_token)
politiki_token_mean

# A tibble: 8 × 4
  author  median_token mean_token sd_token
  <chr>          <dbl>      <dbl>    <dbl>
1 fajon             27       31.2    11.4 
2 jckralj           27       30.3    10.3 
3 mesec             27       29.5    12.6 
4 tonin             25       26.2     7.68
5 alogar            25       25.0     6.71
6 jansa             25       23.8     7.20
7 npmusar           21       23.7    13.8 
8 zturk             20       21.7    11.5 

4.2.3.5 Povedi

Show the code

politiki_povedi <- politiki_df %>% 
  unnest_tokens(poved, text, "sentences")

Show the code

politiki_povedi %>% 
  group_by(author) %>% 
  summarise(median_sent = median(ntoken(poved)), 
            mean_sent = mean(ntoken(poved)),
            sd_sent = sd(ntoken(poved)),
            char_sent = mean(nchar(poved))) %>% 
  arrange(-mean_sent)

# A tibble: 8 × 5
  author  median_sent mean_sent sd_sent char_sent
  <chr>         <dbl>     <dbl>   <dbl>     <dbl>
1 jckralj          14      15.1    9.12      88.4
2 mesec            13      14.7    9.58      78.6
3 tonin            14      14.3    8.38      80.4
4 fajon            12      13.8    8.78      79.4
5 jansa            12      13.2    8.14      72.5
6 alogar           12      12.9    8.20      73.2
7 zturk            10      11.9    7.55      63.7
8 npmusar           9      10.9    7.00      60.8

4.2.3.6 Ngrami

Show the code

politiki_ngrams <- politiki_df %>% 
  unnest_tokens(ngram, text, "ngrams", n = 2)

Show the code

politiki_ngrams %>% 
  group_by(author) %>% 
  count(ngram, sort = TRUE)

# A tibble: 289,152 × 3
# Groups:   author [8]
   author  ngram                n
   <chr>   <chr>            <int>
 1 jckralj https t.co        1145
 2 fajon   https t.co        1106
 3 fajon   rt strankasd       966
 4 npmusar https t.co         832
 5 zturk   https t.co         710
 6 jansa   https t.co         694
 7 alogar  https t.co         643
 8 tonin   https t.co         557
 9 tonin   rt novaslovenija   527
10 mesec   https t.co         447
# … with 289,142 more rows

4.2.3.7 Besede

Show the code

politiki_besede <- politiki_df %>% 
  unnest_tokens(word, text, "words")

Show the code

politiki_besede %>% 
  group_by(author) %>% 
  count(word, sort = TRUE)

# A tibble: 101,633 × 3
# Groups:   author [8]
   author  word      n
   <chr>   <chr> <int>
 1 tonin   rt     2313
 2 jckralj v      2179
 3 jckralj in     2162
 4 jansa   rt     2109
 5 alogar  rt     2061
 6 fajon   in     2017
 7 fajon   v      1961
 8 jckralj za     1932
 9 jckralj rt     1691
10 fajon   rt     1583
# … with 101,623 more rows

---

Pogovori o ukrepih proti covidu





Pogovori o vojni v Ukrajini

4.3 Označevanje in lematizacija besed v podnapisih

4.3.1 Prilaganje podnapisov

Za jezikovno gradivo izberemo podnapise filma Avatar, ki so bili prevedeni v slovenščino. Primerjave podnapisov v več jezikih najdete v spletni knjigi Petrič 2022

Show the code

avatar_slv <- read_lines("data/sub/Avatar_slv.txt")
head(avatar_slv, 10)

 [1] ""                                            
 [2] "1"                                           
 [3] "00:00:38,160 --> 00:00:40,720"               
 [4] "<i>Ko sem ležal v veteranski bolnišnici</i>" 
 [5] ""                                            
 [6] "2"                                           
 [7] "00:00:40,755 --> 00:00:43,280"               
 [8] "<i>z veliko praznino v svojem življenju,</i>"
 [9] ""                                            
[10] "3"                                           

Podnapisi nimajo primerne oblike za jezikovno analizo. Potrebujemo le vrstice z dialogom. Le-te želimo pretvoriti v obliko tabele, kar nam omogoča oblikovanje in analizo besedila s programskimi funkcijami tidyverse ali quanteda.

Show the code

c1 = avatar_slv %>% 
  as_tibble() %>% 
  mutate(row_tc = row_number()) %>% 
  filter(str_detect(value, "-->")) %>% 
  rename(timecode = value)

c2 = avatar_slv %>% 
  as_tibble() %>% 
  mutate(row_id = row_number()) %>% 
  filter(str_detect(value, "[a-zA-Z]")) %>% 
  rename(text = value) %>% 
  mutate(text = str_replace(text, "\\<i\\>", "")) %>% 
  mutate(text = str_replace(text, "\\</i\\>", "")) %>% 
  mutate(language = "slv")

# avatar_slv = bind_cols(a1,a2)
#   select(timecode, text) %>% 
#   separate(timecode, into = c("start", "end"), sep = "\\-\\-\\>")
# tail(avatar_slv)

avatxt = c2 %>% 
  # opcija: dodaj stolpec s prvotnimi številkami vrstic v podnapisih
  mutate(sentence_id = row_number()) %>% 
  # regex: odstrani pomišljaj pred besedo
  mutate(text = str_replace(text, "(–)([a-zA-Z蚞ȊŽ]+)", "\\2"))

head(avatxt)

# A tibble: 6 × 4
  text                                  row_id language sentence_id
  <chr>                                  <int> <chr>          <int>
1 Ko sem ležal v veteranski bolnišnici       4 slv                1
2 z veliko praznino v svojem življenju,      8 slv                2
3 sem začel sanjati o letenju.              12 slv                3
4 Bil sem svoboden.                         16 slv                4
5 Toda prej ali slej se moraš zbuditi.      20 slv                5
6 V kriospanju sploh ne sanjaš.             24 slv                6

4.3.2 Uporaba udpipe

Za označevanje (POS Tagging) in lematizacijo besedilnih enot nam je več knjižnic na razpolago, najpogosteje uporabljeni pa sta spacyr in udpipe. Knjižnica spacyr zahteva namestitev programskih knjižnic v jeziku Python in za zdaj ne omogoča označevanja slovenskih besednih oblik. To sta dva tehtna razloga za uporabo knjižnice udpipe.

Najprej si moramo priskrbeti jezikovni model za slovenščino z interneta. V sledečem programskem odstavku R preverja, ali je navedena datoteka (destfile = …) že v delovni mapi. Če je še ni, potem jo potegne s privzetega strežnika na računalnik. Če je jezikovni model že v delovni mapi, preskoči nalaganje z interneta in naloži model z diska v delovni pomnilnik računalnika.

Show the code

library(udpipe)
destfile = "slovenian-ssj-ud-2.5-191206.udpipe"

if(!file.exists(destfile)){
   jezikovni_model <- udpipe_download_model(language = "slovenian")
   udmodel_sl <- udpipe_load_model(jezikovni_model$file_model)
   } else {
  file_model = destfile
  udmodel_sl <- udpipe_load_model(file_model)
}

Naslednji programski odstavek vsebuje funkcijo tipa “Sam svoj mojster” 🤔. Lastnoročna izdelana funkcija poskrbi za to, da tabeli dodamo več stolpcev, ki vsebujejo označbe besednih oblik in količine za merjenje dolžine besed ali povedi.

Show the code

tokenize_annotate = function(tbl){
  tbl %>% 
  unnest_tokens(word, token, drop = F) %>% 
  cbind_morphological(term = "feats",  
                      which = c("PronType","NumType","Poss","Reflex",
                                "Foreign","Abbr","Typo",
                                "Gender","Animacy","NounClass",
                                "Case","Number","Definite","Degree",
                                "VerbForm","Person","Tense","Mood",
                                "Aspect","Voice","Evident",
                                "Polarity","Polite","Clusivity")) %>% 
  mutate(txt = str_replace_all(sentence, "[:punct:]", "")) %>% 
  mutate(sentlen = quanteda::ntoken(txt)) %>% 
  mutate(syllables = nsyllable::nsyllable(txt)) %>% 
  mutate(types = quanteda::ntype(txt)) %>% 
  mutate(wordlen = syllables/sentlen) %>% 
  mutate(ttr = types/sentlen) %>% 
  select(-txt, -feats)
}

Po potrebi lahko poskrbimo tudi za ohranitev stolpcev iz prvotne tabele, ki bi se sicer v procesu označevanja besedilnih enot izgubile.

Show the code

# keep columns of interest
# these columns will be fed into doc_id of udpipe
# afterwards the doc_id column will be separated
keepcol <- paste(avatxt$row_id, avatxt$language, 
                 sep = "_")

Programski odstavek, ki poskrbi za označevanje besednih oblik.

Show the code

udp <- udpipe_annotate(
  # jezikovni model za slovenščino
  object = udmodel_sl, 
  # izbrani podnapisi
  x = as.character(avatxt$text),
  # opcija: prilagodimo doc_id
  doc_id = as.character(keepcol),
  # pokaže potek označevanja, če TRUE
  trace = TRUE)

udp <- as.data.frame(udp) 
  
udpiped <- udp %>% 
  # gornja lastnoročna izdelana funkcija
  tokenize_annotate() %>% 
  # oblikovanje vsebine stolpcev
  mutate(token_id = as.numeric(token_id),
         head_token_id = as.numeric(head_token_id)) %>% 
  # razdeli stolpec doc_id na več novih
  separate(doc_id, 
           into = c("row_id", "language"), 
           sep = "_", extra = "merge")

# shrani tabelo v varčni obliki (le R zna brati take datoteke)
saveRDS(udpiped, "data/avatar_slv_udpiped.rds")

Da malo pospešimo delo, bomo kar naložili že pripravljeno datoteko z diska.

Show the code

udpiped <- read_rds("data/avatar_slv_udpiped.rds")
head(udpiped, 3) %>% rmarkdown::paged_table()

4.3.3 Besedne vrste

Katere besedne vrste in koliko pojavnic je program prepoznal?

Show the code

bes_vrste <- udpiped %>% 
  count(upos, sort = T) %>% 
  mutate(pct = round(100*n/sum(n), 2))
bes_vrste %>% 
  rmarkdown::paged_table()

Show the code

bes_vrste %>% 
  # izloči ločila in neznano besedno vrsto
  filter(!upos %in% c("X", "PUNCT")) %>% 
  # razvrščaj besedne vrste po odstotkih
  mutate(upos = fct_reorder(upos, pct)) %>% 
  # pct delimo s 100, ker bomo spodaj uveljavili "percent_format"
  ggplot(aes(pct/100, upos, color = upos)) +
  # nariši črte
  geom_segment(aes(x = 0, xend = pct/100, y = upos, yend = upos)) +
  # dodaj pike oz. bucke
  geom_point(size = 3) +
  # uporabi oblikovalno predlogo
  theme_light() +
  # uveljavi oblikovanje x osi (enota je odstotek)
  scale_x_continuous(labels = percent_format(accuracy = 1)) +
  # imena osi niso potrebna
  labs(x = "", y = "") +
  # odstrani legendo
  theme(legend.position = "none")

Error in percent_format(accuracy = 1): could not find function "percent_format"

4.3.4 Samostalniki

Kateri samostalniki so bili najpogosteje uporabljeni v podnapisih?

Show the code

samostalniki <- udpiped %>% 
  # izberi le samostalnike
  filter(upos == "NOUN") %>% 
  # opcija: samo male črke
  # mutate(lemma = tolower(lemma)) %>% 
  # preštej in razvrščaj
  count(lemma, sort = T) %>% 
  # dodaj stolpec z odstotki
  mutate(pct = round(100*n/sum(n), 2))

samostalniki %>% 
  rmarkdown::paged_table()

Show the code

samostalniki %>% 
  # razvrščaj slovarske enote glede na odstotkovno pogostnost
  mutate(lemma = fct_reorder(lemma, pct)) %>% 
  # pokaži samo prvih 20
  head(20) %>% 
  ggplot(aes(pct/100, lemma, color = lemma)) +
  # nariši črto
  geom_segment(aes(x = 0, xend = pct/100, y = lemma, yend = lemma)) +
  # nariši točko oz. bucko
  geom_point(size = 3) +
  # izberi oblikovalno predlogo
  theme_light() +
  # x os naj ima odstotke kot enoto
  scale_x_continuous(labels = percent_format(accuracy = 1)) +
  # brez imen osi
  labs(x = "", y = "") +
  # brez legende
  theme(legend.position = "none")

Error in percent_format(accuracy = 1): could not find function "percent_format"

S funkcijo xray() knjižnice quanteda.textplots lahko pokažemo, v katerih vrsticah podnapisov (ki ima 1606 vrstic) se pojavljajo izbrane besede, npr. imena glavnih likov filma.

Show the code

textplot_xray(
  kwic(avatxt %>% pull(text), 
                 pattern = c("Grace","Tsu'tey")), 
  scale = "relative")

V katerih oblikah in v katerih vrsticah podnapisov nastopa slovarska enota (lemma) brat?

Show the code

udpiped %>% 
  # izberi vrstice s slovarsko enoto "brat"
  filter(lemma == "brat") %>% 
  # izberi stolpce za prikaz
  select(sentence, token, lemma, upos, xpos, dep_rel) %>% 
  rmarkdown::paged_table()

Z naslednjo poizvedbo želimo najti samostalnike v množinski obliki.

Show the code

#Find all plural nouns (tokens)
udpiped %>% 
  # nastavimo ustrezne filtre za izbor vrstic tabele
  filter(language == "slv" & # tu nepotrebno, ker imamo samo slv
           upos == "NOUN" & 
           morph_number == "Plur") %>% 
  select(sentence, token, lemma, upos, xpos, morph_number) %>% 
  rmarkdown::paged_table()

V sledečem programskem odstavku sestavljamo tabelo o pogostnosti edninskih množinskih in dvojinskih oblik samostalnikov.

Show the code

udpiped %>% 
  # izberemo relevantne stolpce
  dplyr::select(language, token, lemma, upos, morph_number) %>% 
  # tu ni potrebno, ker imamo samo slv podnapise
  group_by(language) %>% 
  # izbere le vrstice s samostalniki
  filter(upos == "NOUN") %>% 
  # preštej vrstice v stolpcu o številu
  count(morph_number) %>% 
  # preoblikuj tabelo iz dolge v široko obliko (lažje beremo)
  pivot_wider(names_from = language, values_from = n) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  # v vseh stolpcih zamenjaj NA z ničlo
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  # v stolpcu zamenjaj črkovni niz "0" z opisno vrednostjo "Unknown"
  mutate(morph_number = 
           str_replace(morph_number, "0", "Unknown")) %>% 
  # uredi stopnje v kategoriji število po zaznamovanosti
  mutate(morph_number = 
           fct_relevel(
             morph_number, levels =
                         c("Sing","Plur","Dual","Unknown"))) %>% 
  # dodal naknadno: odstotke
  mutate(pct = round(100*slv/sum(slv), 2)) %>% 
  # razvrščaj po stopnjah kategorije število
  arrange(morph_number) %>% 
  rmarkdown::paged_table()

4.3.5 Pridevniške oblike

Show the code

udpiped %>% 
  # grupiranje tu ni potrebno, ker imamo samo slv podnapise
  group_by(language) %>% 
  # izbor jezikov tu ni potreben
  filter(language == "eng" | 
           language == "deu" | language == "slv") %>% 
  # izberi le vrstice s pridevniki
  filter(upos == "ADJ") %>% 
  # preštej stopnjevalne oblike in razvrščaj
  count(morph_degree, sort = TRUE) %>% 
  # dodaj stolpec z odstotki
  mutate(pct = round(100*n/sum(n),2)) %>% 
  # preoblikuj dolgo tabelo v široko obliko
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  # v vseh stolpcih zamenjaj NA z ničlo
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  # v stolpcu zamenjaj niz "0" z opisom "Unknown"
  mutate(morph_degree = 
           str_replace(morph_degree, "0", "Unknown")) %>% 
  # uredi vrstni red stopnjevalnih stopenj pridevnikov
  mutate(morph_degree = 
           fct_relevel(
             morph_degree, levels =
                         c("Pos","Cmp","Sup","Abs","Unkown"))) %>% 
  # razvrščaj
  arrange(morph_degree) %>% 
  rmarkdown::paged_table()

4.3.6 Skladenjske analize

4.3.6.1 UD shema

Tipološke za označevanje besedilnih enot: Universal Stanford Dependencies: A cross-linguistic typology (de Marneffe et al. 2014).

Show the code

knitr::include_graphics("pictures/Screenshot 2021-08-27 at 12-14-22 Universal Dependency Relations.png")

4.3.6.2 Dependenčni odnosi

V naslednjem programskem odstavku sestavljamo tabelo za prikaz skladenjskih prvin po kategorijah UD (gl. zgoraj), in sicer na enak način kot v prejšnjih odstavkih (gl. pojasnila tam).

Show the code

udpiped %>% 
  group_by(language) %>% 
  filter(language == "eng" | 
           language == "deu" | language == "slv") %>% 
  count(dep_rel, sort = TRUE) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  mutate(dep_rel = 
           str_replace(dep_rel, "0", "Unknown")) %>% 
  rmarkdown::paged_table()

Koren odvisnostnega odnosa (root of dependency relation) nam pove, ali je bilo zaporedje besed identificirano kot stavek. Običajno se določi s pomočjo (osebne) glagolske oblike v stavku. V eliptičnih stavkih je ena od besednih oblik, ki se pojavi, povezana s korenom.

Iz tabele (gl. root, koren) je razvidno, da je v slovenskih podnapisih prepoznanih 1807 stavčnih enot.

Naslednji programski odstavek vsebuje lastnoročno izdelano funkcijo za risanje dependenčnih odnosov v stavkih. Prevzeli smo jo od poišči, potem pa prilagodili našim potrebam. Spodaj jo bomo videli v akciji.

Show the code

library(igraph)
library(ggraph)
library(ggplot2)

plot_annotation <- function(x, size = 3){
  stopifnot(is.data.frame(x) & all(c("sentence_id", "token_id", "head_token_id", "dep_rel", "token_id", "token", "lemma", "upos", "xpos", "feats") %in% colnames(x)))
  x <- x[!is.na(x$head_token_id), ]
  x <- x[x$sentence_id %in% min(x$sentence_id), ]
  edges <- x[x$head_token_id != 0, c("token_id", "head_token_id", "dep_rel")]
  edges$label <- edges$dep_rel
  g <- graph_from_data_frame(edges,
                             vertices = x[, c("token_id", "token", "lemma", "upos", "xpos", "feats")],
                             directed = TRUE)
  windowsFonts("Arial Narrow" = windowsFont("Arial"))
  ggraph(g, layout = "linear") +
    geom_edge_arc(ggplot2::aes(label = dep_rel, vjust = -0.20),
                  arrow = grid::arrow(length = unit(4, 'mm'), ends = "last", type = "closed"),
                  end_cap = ggraph::label_rect("wordswordswords"),
                  label_colour = "red", check_overlap = TRUE, label_size = size) +
    geom_node_label(ggplot2::aes(label = token), col = "darkgreen", size = size, fontface = "bold") +
    geom_node_text(ggplot2::aes(label = upos), nudge_y = -0.35, size = size) +
    theme_graph(base_family = "Arial Narrow") +
    labs(title = "udpipe output", subtitle = "tokenisation, parts of speech tagging & dependency relations")
}

Cilj naslednjega programskega odstavka je narisati diagram, ki prikazuje dependenčne odnose med stavčnimi prvinami. Stavek je iz slovenskih podnapisov za film Avatar.

Show the code

# Slovenian: v navednicah izbrani stavek
mytext = "Začel sem sanjati o letenju" %>% 
  # pretvori gornji niz po kodirni shemi utf8
  enc2utf8()
# izberi stavek in jezikovni model in označuj oblike
x = udpipe(mytext, "slovenian")
# nariši oblikoskladenjsko označen stavek (gl. funkcijo zgoraj)
x3 = plot_annotation(x, size = 3)
x3

4.3.6.3 Osebki

Koliko osebkov najdemo s programom? Prilagodimo zgoraj že večkrat sestavljeno tabelo novi poizvedbi.

Show the code

udpiped %>% 
  group_by(language) %>% 
  filter(language == "eng" | 
           language == "deu" | language == "slv") %>% 
  filter(str_detect(dep_rel, "nsubj")) %>% 
  count(dep_rel, sort = TRUE) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  mutate(dep_rel = 
           str_replace(dep_rel, "0", "Unknown")) %>% 
  rmarkdown::paged_table()

Oglejmo si nekaj vrstic, ki vsebujejo osebek. Prekopiramo še eno tabelo, jo nekoliko prilagodimo novi poizvedbi.

Show the code

udpiped %>% 
  group_by(language) %>% 
  filter(language == "slv") %>% 
  filter(str_detect(dep_rel, "nsubj")) %>% 
  ungroup() %>% 
  select(sentence, sentence_id) %>% 
  distinct() %>% 
  head(5) %>% rmarkdown::paged_table()

Izberimo vrstico neposredno iz tabele podnapisov in narišimo dependenčne odnose v izbranem stavku. Kako je osebek upodobljen v odvisnostnem diagramu?

Show the code

avatxt %>% 
  filter(language == "slv") %>% 
  filter(str_detect(text, "dobi svojega avatarja")) %>% 
  select(text) %>% rmarkdown::paged_table()

Show the code

# Slovenian
mytext = "Vsak upravljavec dobi svojega avatarja" %>% enc2utf8()
x = udpipe(mytext, "slovenian")
x3 = plot_annotation(x, size = 3)
x3

4.3.6.4 Zaimki in samostalniki

Cilj naslednjega programskega odstavka je ugotoviti, v katerih stavčnih vlogah (osebek, tožilniški (strukturni) predmet, dajalniški predmet ali slovarsko določeni predmet) nastopajo zaimki in samostalniki. Prekopiramo zgoraj že večkrat uporabljeno tabelo in jo prilagodimo novim zahtevam.

Show the code

udpiped %>% 
  group_by(language) %>% 
  filter(upos == "NOUN" | upos == "PRON") %>% 
  filter(str_detect(dep_rel, "nsubj|obj|obl")) %>% 
  count(upos, dep_rel) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  arrange(upos) %>% 
  rmarkdown::paged_table()

Recikliramo tabelo, tokrat za prikaz števila in deležev osebkov z ozirom na zaimensko ali samostalniško obliko.

Show the code

udpiped %>% 
  group_by(language) %>% 
  filter(language == "eng" | 
           language == "deu" | language == "slv") %>% 
  filter(upos == "NOUN" | upos == "PRON") %>% 
  filter(str_detect(dep_rel, "nsubj")) %>% 
  count(upos, dep_rel) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  arrange(upos) %>% 
  rmarkdown::paged_table()

Izdelamo lastno (večkrat uporabno) funkcijo za pretvorbo dolgih tabel v široke tabele (ki jih ljudje lažje beremo).

Show the code

pivot_by_nsubj <- function(tbl) {
  tbl %>% 
    filter(upos == "NOUN" | upos == "PRON") %>% 
    filter(str_detect(dep_rel, "nsubj")) %>% 
    count(upos, dep_rel) %>% 
    group_by(upos) %>% 
    mutate(pct = round(100*n/sum(n),2)) %>% 
    pivot_wider(names_from = upos, values_from = c(n, pct)) %>% 
    mutate_if(is.numeric, ~ replace_na(.x, 0))
    # mutate(across(everything(), ~ replace_na(.x, 0))) 
}

# uporabi gornjo funkcijo
x = udpiped %>% 
  filter(language == "slv") %>% 
  pivot_by_nsubj()

x %>% rmarkdown::paged_table()

Oglejmo si nekaj primerov iz podnapisov filma Avatar, ki vsebujejo samostalnik ali zaimek v vlogi osebka!

Show the code

udpiped %>% 
  select(sentence, upos, dep_rel, language) %>% 
  filter(language == "slv") %>% 
  filter(upos == "NOUN" | upos == "PRON") %>% 
  filter(str_detect(dep_rel, "nsubj")) %>% 
  rmarkdown::paged_table()

Prekopiramo tabelo in jo prilagodimo za prikaz pogostnosti tožilniškega predmeta v samostalniški ali zaimenski obliki.

Show the code

x = udpiped %>% 
  group_by(language) %>% 
  filter(upos == "NOUN" | upos == "PRON") %>% 
  filter(dep_rel == "obj") %>% 
  count(upos, dep_rel) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  arrange(upos)

x %>% rmarkdown::paged_table()

V naslednjem programskem odstavku sestavljamo preglednico za prikaz samostalnikov in zaimkov v vlogi osebka ali tožilniškega predmeta. Tabelo smo spet prekopirali in nekoliko prilagodili novim zahtevam.

Show the code

udpiped %>% 
  group_by(language) %>% 
  filter(upos == "NOUN" | upos == "PRON") %>% 
  filter(dep_rel == "nsubj" | dep_rel == "obj") %>% 
  count(upos, dep_rel) %>% 
  # group_by(upos) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = language, values_from = c(n, pct)) %>% 
  # mutate(across(everything(), ~ replace_na(.x, 0))) %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0)) %>% 
  arrange(upos) %>% 
  rmarkdown::paged_table()

Lastnoročno izdelana funkcija v naslednjem programskem odstavku za pretvorbo dolge tabele v široko obliko je skoraj enaka kot malo prej sestavljena, razlika je le, da tokrat vključujemo osebke in preme (tožilniške) predmete.

Show the code

pivot_by_obj <- function(tbl) {
  tbl %>% 
    filter(upos == "NOUN" | upos == "PRON") %>% 
    filter(dep_rel == "nsubj" | dep_rel == "obj") %>% 
    count(upos, dep_rel) %>% 
    group_by(upos) %>%
    mutate(pct = round(100*n/sum(n),2)) %>% 
    pivot_wider(names_from = upos, values_from = c(n, pct)) %>% 
    mutate_if(is.numeric, ~ replace_na(.x, 0))
    # mutate(across(everything(), ~ replace_na(.x, 0)))
}

# uporabi gornjo funkcijo
x = udpiped %>% 
  filter(language == "slv") %>% 
  pivot_by_obj()
  
x %>% rmarkdown::paged_table()

S hi kvadrat preizkusom lahko ugotovimo neodvisnost (odvisnost) obeh vzorcev (samostalniškega in zaimenskega). V tem primeru je p vrednost manjša kot mejna vrednost (p < 0,05), tj. statistična značilna. Vzorca nista neodvisna: skladenjska vloga (osebek ali predmet) je povezana s besedno vrsto (zaimek ali samostalnik)

Show the code

# Base-R
hi <- chisq.test(x[,c(2:3)])
hi

    Pearson's Chi-squared test with Yates' continuity correction

data:  x[, c(2:3)]
X-squared = 71.069, df = 1, p-value < 2.2e-16

Show the code

# opazovane pogostnosti
hi$observed

     n_NOUN n_PRON
[1,]    192     57
[2,]    175    231

Show the code

# pričakovane pogostnosti po ničelni domnevi (tj. da ni razlike med vzorcema oz. da sta vzorca neodvisna)
hi$expected

      n_NOUN  n_PRON
[1,] 139.516 109.484
[2,] 227.484 178.516

V spletni knjigi Petrič 2022 je še več skladenjskih analiz s programom udpipe, ki si jih lahko ogledate (npr. besedni vrstni red v samostalniških besednih zvezah ali stavkih).

4.4 Označevanje: YouTube

4.4.1 Preberi in združi

Sledeče podatkovne nize smo pridobili s pomočjo YouTube Data Tools (https://tools.digitalmethods.net/netvizz/youtube/). Orodje je sprogramiral “Bernhard Rieder […] an associate professor in New Media and Digital Culture at the University of Amsterdam and a researcher with the Digital Methods Initiative.” (http://thepoliticsofsystems.net/about/).

Dva video posnetka na portalu YouTube sta povezana z znanima slovenskima politikoma, Zoranom Jankovićem in Janezom Janšo. Gledalci oddaje 24 ur so po ogledu oddali svoje pripombe. V tretjem video posnetku (file = 2) je novinarka spraševala ljudi, kaj delajo za božič. Gledalci so po ogledu oddali svoje pripombe.

Show the code

gpath <-list.files(path = "data/youtube/",
                   pattern = "_comments.csv", 
                   full.names = TRUE)

comments <- map_dfr(gpath, read_csv, .id = "file") %>% 
  # dodelimo vsaki datoteki prepoznavno ime
  # namesto ifelse() uporabljamo case_when()
  mutate(file = case_when(
    file == "1" ~ "24ur_Jansa",
    file == "2" ~ "24ur_bozic",
    file == "3" ~ "24ur_Jankovic",
    TRUE ~ "other"
  ))

names(comments)

 [1] "file"             "id"               "replyCount"       "likeCount"       
 [5] "publishedAt"      "authorName"       "text"             "authorChannelId" 
 [9] "authorChannelUrl" "isReply"          "isReplyTo"        "isReplyToName"   

4.4.2 Nezaželene besede

Show the code

stop_sl <- quanteda::stopwords(language = "sl", 
                               source = "stopwords-iso")

stop_sl <- c(quanteda::stopwords(language = "sl", 
                       source = "stopwords-iso"), 
             "\n", " ", "[\\d]+", "quot", "še", "^www.+", "^http.+", 
             "search_query")

stop_sl_tidy <- stop_sl %>% as_tibble() %>% rename(word = value)

# remove stopwords and punctuation and digits
stop_sl_collapsed <- paste0(paste0('\\b', stop_sl, '\\b', 
     collapse = "|"), '|[[:punct:]]+', "[\\d]+")

# another variant
stops <- paste0(stop_sl, collapse = "\\b|\\b")

Nekaj naključno izbranih pripomb gledalcev.

Show the code

comments %>% slice_sample(n = 10)

# A tibble: 10 × 12
   file  id    reply…¹ likeC…² publishedAt         autho…³ text  autho…⁴ autho…⁵
   <chr> <chr>   <dbl>   <dbl> <dttm>              <chr>   <chr> <chr>   <chr>  
 1 24ur… Ugiv…      NA       3 2020-03-27 22:06:51 Mark    "Js … UCKw2M… http:/…
 2 24ur… Ugxe…      NA       0 2021-12-24 15:48:46 Mitja … "Gle… UCv5Aq… http:/…
 3 24ur… Ugww…      NA       1 2021-01-31 00:21:22 luksur… "@Al… UC02WL… http:/…
 4 24ur… Ugyv…       0       1 2021-04-24 22:29:14 matija  "Zak… UC3jHx… http:/…
 5 24ur… Ugxe…      NA       0 2020-09-14 17:39:57 back2b… "202… UCmCz6… http:/…
 6 24ur… Ugj7…      NA       0 2021-06-15 19:46:35 TadeSLO "Za … UCyXOd… http:/…
 7 24ur… Ugxd…      NA       4 2021-03-01 22:11:07 Josko … "@AL… UCZMnW… http:/…
 8 24ur… Ugyv…       0       0 2012-01-25 11:04:26 Sale G… "2pe… UCSTa6… http:/…
 9 24ur… UgxM…      NA       4 2021-02-24 20:46:22 ALES G… "@Ma… UCLJqG… http:/…
10 24ur… Ugx1…       0       0 2011-11-24 12:19:28 Polenar "bol… UCFbIx… http:/…
# … with 3 more variables: isReply <dbl>, isReplyTo <chr>, isReplyToName <chr>,
#   and abbreviated variable names ¹​replyCount, ²​likeCount, ³​authorName,
#   ⁴​authorChannelId, ⁵​authorChannelUrl

4.4.3 Uporaba udpipe

Najprej naložimo jezikovni model za slovenščino v pomnilnik računalnika. Prekopiramo programski odstavek iz prejšnjega poglavja.

Show the code

library(udpipe)
destfile = "slovenian-ssj-ud-2.5-191206.udpipe"

if(!file.exists(destfile)){
   jezikovni_model <- udpipe_download_model(language = "slovenian")
   udmodel_sl <- udpipe_load_model(jezikovni_model$file_model)
   } else {
  file_model = destfile
  udmodel_sl <- udpipe_load_model(file_model)
}

Prekopiramo tudi programski odstavek z lastnoročno izdelano programsko funkcijo za prilagajanje in dopolnjevanje tabele.

Show the code

tokenize_annotate = function(tbl){
  tbl %>% 
  unnest_tokens(word, token, drop = F) %>% 
  cbind_morphological(term = "feats",  
                      which = c("PronType","NumType","Poss","Reflex",
                                "Foreign","Abbr","Typo",
                                "Gender","Animacy","NounClass",
                                "Case","Number","Definite","Degree",
                                "VerbForm","Person","Tense","Mood",
                                "Aspect","Voice","Evident",
                                "Polarity","Polite","Clusivity")) %>% 
  mutate(txt = str_replace_all(sentence, "[:punct:]", "")) %>% 
  mutate(sentlen = quanteda::ntoken(txt)) %>% 
  mutate(syllables = nsyllable::nsyllable(txt)) %>% 
  mutate(types = quanteda::ntype(txt)) %>% 
  mutate(wordlen = syllables/sentlen) %>% 
  mutate(ttr = types/sentlen) %>% 
  select(-txt, -feats)
}

Naslednji trije programski odstavki (podobno kot v prejšnjem poglavju) poskrbijo za označevanje besednih oblik v prispevkih gledalcev YouTube video prispevka, dodajamo pa tudi stolpec za razlikovanje treh vzorcev.

Show the code

jansa <- comments %>% filter(file == "24ur_Jansa")
x = udpipe_annotate(udmodel_sl, x = jansa$text, trace = F)
jansa_ud = as.data.frame(x)

jansa_udpiped <- jansa_ud %>% 
  tokenize_annotate() %>% 
  mutate(file = "jansa") %>% 
  mutate(token_id = as.numeric(token_id),
         head_token_id = as.numeric(head_token_id))

Show the code

bozic <- comments %>% filter(file == "24ur_bozic")
x = udpipe_annotate(udmodel_sl, x = bozic$text, trace = F)
bozic_ud = as.data.frame(x)

bozic_udpiped <- bozic_ud %>% 
  tokenize_annotate() %>% 
  mutate(file = "bozic") %>% 
  mutate(token_id = as.numeric(token_id),
         head_token_id = as.numeric(head_token_id))

Show the code

janko <- comments %>% filter(file == "24ur_Jankovic")
x = udpipe_annotate(udmodel_sl, x = janko$text, trace = F)
janko_ud = as.data.frame(x)

janko_udpiped <- janko_ud %>% 
  tokenize_annotate() %>% 
  mutate(file = "jankovic") %>% 
  mutate(token_id = as.numeric(token_id),
         head_token_id = as.numeric(head_token_id))

Združujemo vzorce v eno tabelo.

Show the code

g_udpiped <- bind_rows(jansa_udpiped, bozic_udpiped, janko_udpiped)
dim(g_udpiped)

Shranimo za kasnejšo ponovno uporabo, in sicer v varčni obliki rds. Te datoteke odpira le R.

Show the code

saveRDS(g_udpiped, 
        "data/youtube_comments_sl_jansa-bozic-jankovic.rds")

Da prihranimo nekaj časa, prejšnjih pet odstavkov ni bilo izvedenih (#| eval: false). Zato datoteko v naslednjem odstavku naložimo v pomnilnik.

Show the code

g_udpiped <- read_rds("data/youtube_comments_sl_jansa-bozic-jankovic.rds")

4.4.4 Glagoli

Na hitro poglejmo, kateri glagoli v prispevkih gledalcev prevladujejo.

V preglednici opazimo nekaj napak: besedila bi bilo treba sistematično pregledovati in popraviti najbolj moteče nepravilnosti kot npr. manjkajoč presledek za piko (npr. tega.Zelo) in očitne tipkovne napake gledalcev pri pisanju prispevkov (npr. jepostavil).

Show the code

g_udpiped %>% 
  filter(upos == "VERB") %>% 
  select(token, lemma, upos, xpos) %>% 
  rmarkdown::paged_table()

Katere oblikoslovne oblike glagolov prevladujejo?

Show the code

g_udpiped %>% 
  filter(upos == "VERB") %>% 
  select(token, lemma, upos, xpos) %>% 
  count(xpos, sort = T) %>% 
  rmarkdown::paged_table()

Ali se pogostnost glagolov razlikuje glede na tematiko video prispevka, ki so si ga gledalci ogledali?

Show the code

verbs_in_comments <- g_udpiped %>%
  filter(upos == "VERB") %>% 
  filter(!str_detect(lemma, "^http")) %>% 
  filter(!str_detect(lemma, ";sti")) %>% 
  group_by(file) %>% 
  count(lemma, sort = T) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  pivot_wider(names_from = file, values_from = c(pct, n), values_fill = 0) %>% 
  arrange(-pct_jansa)

verbs_in_comments %>% rmarkdown::paged_table()

Show the code

# write.csv2(verbs_in_comments, "data/youtube_sl_verbs_comments.csv")

Pripombe gledalcev k trem oddajam v obliki besednih oblakov:

Show the code

library(ggwordcloud)
p0 <- g_udpiped %>%
  filter(upos == "VERB") %>% 
  filter(!str_detect(lemma, "^http")) %>% 
  filter(!str_detect(lemma, ";sti")) %>% 
  group_by(file) %>% 
  count(lemma, sort = T) %>% 
  mutate(pct = round(100*n/sum(n),2)) %>% 
  slice_head(n = 40) %>% 
  ggplot(aes(pct/100, label = lemma, size = log(pct), color = pct)) +
  geom_text_wordcloud() +
  theme_light() +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(x="") +
  facet_grid(~ file, scales = "free")

ggsave("pictures/youtube_comments_sl_verbs.png", dpi = 300,
       width = 10, height = 4)

p0

Glagol biti je seveda najpogostejši glagol v vseh treh skupinah, vendar s precej višjim odstotkom v prispevkih o božiču. V pripombah k oddajam o politikoma poleg glagola biti izstopa predvsem glagol imeti. Mogoče se bo ta (pogostnostna) razlika pokazala tudi pri kolokacijah, pri katerih so sestavni del glagolske oblike.

Podoben pregled značilnih slovarskih enot bi lahko naredili tudi npr. za samostalnike in pridevnike.

Preštejmo še druge besede.

Show the code

# count words and remove numbers (if still present)
word_count <- g_udpiped %>% 
  count(word, sort = T, name = "Freq_word") %>% 
  filter(!str_detect(word, "[\\d]+"))

# Number of words
N <- nrow(word_count)

Show the code

words_video <- g_udpiped %>% 
  group_by(file) %>% 
  # anti_join(stop_sl_tidy, by = "word") %>% # 6435 words
  # filter(!str_detect(word, stop_sl_collapsed)) %>% # 6294 words
  filter(!str_detect(word, stops)) %>% # 5278 words
  count(word, sort = T) %>% 
  drop_na() %>% 
  group_by(file) %>% 
  mutate(pct = round(100*n/sum(n), 3))

dim(words_video)

[1] 5286    4

Show the code

words_video %>% 
  pivot_wider(names_from = file, values_from = n,
              values_fill = 0) %>% 
  ungroup()

# A tibble: 5,286 × 5
   word        pct jansa jankovic bozic
   <chr>     <dbl> <int>    <int> <int>
 1 ales      0.981    48        0     0
 2 edi       1.23      0       41     0
 3 komunisti 0.572    28        0     0
 4 ampak     0.552    27        0     0
 5 let       0.687     0       23     0
 6 pucer     0.687     0       23     0
 7 zoki      0.657     0       22     0
 8 sloveniji 0.45     22        0     0
 9 tem       0.45     22        0     0
10 sloveniji 0.627     0       21     0
# … with 5,276 more rows

Show the code

library(ggwordcloud)
p1 <- words_video %>% 
  slice_head(n = 50) %>% 
  mutate(angle = 45 * sample(-2:2, n(), replace = TRUE, 
                             prob = c(1, 1, 4, 1, 1))) %>% 
  ggplot(aes(label = word, size = pct, color = n), angle = angle) +
  geom_text_wordcloud(shape = "circle", rm_outside = TRUE) +
  scale_size_area(max_size = 20) +
  # scale_radius(range = c(0, 16), limits = c(0, NA)) +
  facet_wrap(~ file, scales = "free")

ggsave("pictures/youtube_sl_words_per_video.png", dpi = 300, 
       width = 10, height = 5)

p1